home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / gwedit.com / AREAWR.PAS next >
Encoding:
Pascal/Delphi Source File  |  1989-03-16  |  7.0 KB  |  215 lines
  1.  
  2. { this unit performs graphics based text writes to the screen }
  3. { released to public domain 3/15/89 by author Michael Day}
  4. {for mouse support, enable the mouse unit in the uses statement}
  5. {and uncomment the HideMouse and ShowMouse procedures in this unit}
  6.  
  7. unit AreaWr;
  8. interface
  9.  
  10. uses graph,{mouse,}gstart;
  11.  
  12. const
  13.       LeftWrite = 0;        {left justify text in box}
  14.       CenterWrite = 1;      {center text in box}
  15.       RightWrite = 2;       {right justify text in box}
  16.       OffLeftWrite = 3;     {left justify text with 1/2 char offset}
  17.       OffRightWrite = 4;    {right justify text with 1/2 char offset}
  18.       PoffLeftWrite = 5;    {left justify with one pixel offset}
  19.       PoffRightWrite = 6;   {right justify with one pixel offset}
  20.  
  21. type
  22.      ColorRec = record
  23.        WritePos    : byte;       { left, center, or right}
  24.        FColor      : byte;       { Foreground color }
  25.        BColor      : byte;       { Background color }
  26.        BPattern    : byte;       { Background pattern }
  27.      end;
  28.  
  29. const
  30.      DummyColors : ColorRec = (WritePos : CenterWrite;
  31.                                FColor   : white;
  32.                                BColor   : black;
  33.                                BPattern : SolidFill);
  34.  
  35. procedure SetColorRec(var C:ColorRec; WP,FC,BC,BP:word);
  36. procedure SetRect(var R:rect; x1,y1,x2,y2:integer);
  37. procedure AreaCharWrite(Ch:Char; R:rect; C:ColorRec; Pos,Wide:word);
  38. procedure AreaWrite(var Item:String;  {string to be written}
  39.                     R:rect;           {area to write it in}
  40.                     C:ColorRec);      {colors and pattern to use}
  41. procedure AreaWritePos(R:rect;           {area to write it in}
  42.                        Direction:word;   {string print direction}
  43.                        Pos:word;         {character to be written}
  44.                        Wide:word;        {width of string space}
  45.                        var X,Y:integer;  {Graphic position of char}
  46.                        var Len:integer); {max char position available}
  47.  
  48.  
  49. implementation
  50.  
  51.  
  52. {----------------------------------------------------------------}
  53. procedure SetColorRec(var C:ColorRec; WP,FC,BC,BP:word);
  54. begin
  55.   C.WritePos := WP;
  56.   C.FColor   := FC;
  57.   C.BColor   := BC;
  58.   C.BPattern := BP;
  59. end;
  60.  
  61. {----------------------------------------------------------------}
  62. procedure SetRect(var R:rect; x1,y1,x2,y2:integer);
  63. begin
  64.   R.Xmin := x1;
  65.   R.Ymin := y1;
  66.   R.Xmax := x2;
  67.   R.Ymax := y2;
  68. end;
  69.  
  70. {----------------------------------------------------------------}
  71. { draw a bar pattern on the screen - remember to save the mouse first! }
  72. { - this is ment for internal use - }
  73. procedure DrawCBar(Area:rect; Colors:ColorRec);
  74. begin
  75.   with Area,Colors do
  76.   begin
  77.     SetFillStyle(BPattern,BColor);
  78.     Bar(Xmin,Ymin,Xmax,Ymax);
  79.   end;
  80. end;
  81.  
  82.  
  83. {----------------------------------------------------------------}
  84. {On entry Len contains the length of the string to be written}
  85. {Direction contains how the string is to be drawn, and R is the area}
  86. {On exit TMax is set to the maximum number of char that can be written}
  87. {sets X to the first position in the rectangle to draw a string}
  88.  
  89. procedure SetAreaWrite(R:rect; Direction:integer; Len:integer;
  90.                        var X:integer; var TMax:integer);
  91. var LenMax : integer;
  92. begin
  93.   TMax := (succ(R.Xmax-R.Xmin) div BoxTextWidth);
  94.   if TMax < Len then LenMax := TMax else LenMax := Len;
  95.   if LenMax < 1 then LenMax := 1;
  96.  
  97.   case Direction of
  98.     CenterWrite :
  99.       begin
  100.         x := R.Xmin +
  101.              succ((R.Xmax-R.Xmin) shr 1) - ((LenMax*BoxTextWidth) shr 1);
  102.       end;
  103.     RightWrite :
  104.       begin
  105.         x := R.Xmax - pred(LenMax*BoxTextWidth);
  106.       end;
  107.     OffLeftWrite :
  108.       begin
  109.         x := R.Xmin + 4;
  110.         TMax := (succ(R.Xmax-x) div BoxTextWidth);
  111.       end;
  112.     OffRightWrite :
  113.       begin
  114.         TMax := (succ(R.Xmax-3-R.Xmin) div BoxTextWidth);
  115.         if TMax < Len then LenMax := TMax else LenMax := Len;
  116.         if LenMax < 1 then LenMax := 1;
  117.         x := R.Xmax - 3 - (LenMax*BoxTextWidth);
  118.       end;
  119.     PoffLeftWrite :
  120.       begin
  121.         x := succ(R.Xmin);
  122.       end;
  123.     PoffRightWrite :
  124.       begin
  125.         x := R.Xmax - (LenMax*BoxTextWidth);
  126.       end;
  127.     else  {LeftWrite}
  128.     begin
  129.       x := R.Xmin;
  130.     end;
  131.   end;
  132. end;
  133.  
  134. {-----------------------------------------------------}
  135. {write the string starting at the left of the given rectangle}
  136. procedure AreaWrite(var Item:String;  {string to be written}
  137.                     R:rect;           {area to write it in}
  138.                     C:ColorRec);      {colors and pattern to use}
  139. var x,y: integer;
  140.     Len:integer;
  141. begin
  142.     SetAreaWrite(R,C.WritePos,length(Item),X,Len);
  143.     y := ((R.Ymax-R.Ymin) shr 1) + succ(R.Ymin);
  144. {    HideMouse;  }
  145.     SetTextJustify(LeftText,CenterText);
  146.     DrawCBar(R,C);
  147.     moveto(x,y);
  148.     setcolor(C.FColor);
  149.     outtext(copy(Item,1,Len));
  150. {    ShowMouse; }
  151. end;
  152.  
  153.  
  154. {-----------------------------------------------------}
  155. {on entry Width contains the string length that is to be written,}
  156. {Pos contains the character position in the string that XY is to}
  157. {point to. R is the area to place the string in, and Direction is}
  158. {the way the string is to be written. On exit X,Y has the screen}
  159. {position of the character specified in Pos. Based on the top left}
  160. {corner of the character cell. Len indicates the largest possible}
  161. {string that can be written in the area.}
  162.  
  163. procedure AreaWritePos(R:rect;           {area to write it in}
  164.                        Direction:word;   {string print direction}
  165.                        Pos:word;         {character to be written}
  166.                        Wide:word;        {width of string space}
  167.                        var X,Y:integer;  {Graphic position of char}
  168.                        var Len:integer); {max char position available}
  169. begin
  170.   SetAreaWrite(R,Direction,Wide,X,Len);    {get first char screen X loc}
  171.   if Len > 0 then
  172.   begin
  173.     if (Len < Pos) or (Pos < 1) then
  174.       X := X + (pred(Len)*BoxTextWidth)
  175.     else
  176.       X := X + (pred(Pos)*BoxTextWidth);
  177.   end;
  178.   if (X+pred(BoxTextWidth)) > R.Xmax then X := X-BoxTextWidth;
  179.   Y := R.Ymin;
  180. end;
  181.  
  182.  
  183. {-----------------------------------------------------}
  184. {write a character on the screen at Pos}
  185. procedure AreaCharWrite(Ch:Char; R:rect; C:ColorRec; Pos,Wide:word);
  186. var X,Y,Len:integer;
  187. begin
  188.     AreaWritePos(R,C.WritePos,Pos,Wide,X,Y,Len);
  189.     y := ((R.Ymax-R.Ymin) shr 1) + succ(R.Ymin);
  190. {    HideMouse; }
  191.     SetTextJustify(LeftText,CenterText);
  192.     SetFillStyle(C.BPattern,C.BColor);
  193.     bar(X,R.Ymin,X+pred(BoxTextWidth),R.Ymax);
  194.     moveto(x,y);
  195.     setcolor(C.FColor);
  196.     outtext(Ch);
  197. {    ShowMouse;   }
  198. end;
  199.  
  200. {-----------------------------------------------------}
  201. {returns the maximum number of characters that can be }
  202. {written in a rectangle }
  203.  
  204. function GetMaxAreaSize(R:rect):word;
  205. begin
  206.   GetMaxAreaSize := succ(R.Xmax-R.Xmin) div BoxTextWidth;
  207. end;
  208.  
  209.  
  210. {----------------}
  211. {no init needed}
  212.  
  213. end.
  214.  
  215.